home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 096 / pakuser.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1985-02-02  |  2.4 KB  |  52 lines
  1. 10  '    PAKUSER Vers.1.0        02-02-85
  2. 20  CLS:KEY OFF:PRINT"Out of the depths of despair, comes......"
  3. 30  FOR I%=1 TO 2000:NEXT I%:BEEP
  4. 40  ON ERROR GOTO 500
  5. 50  CLS:LOCATE 1,34:PRINT"PAKUSER V1.0":MS%=0:MD%=0
  6. 60  LOCATE 3,5:INPUT"USERS file is on drive: ";UDRV$:UDRV$=LEFT$(UDRV$,1)
  7. 70  LOCATE 3,5:INPUT"MESSAGES file is on drive: ";MDRV$:MDRV$=LEFT$(MDRV$,1)
  8. 80  LOCATE 3,5:INPUT"Do you wish to purge by security level Y/N ";A$
  9. 90  A$=LEFT$(A$,1):IF (A$="N") OR (A$="n") THEN 110 ELSE SP%=1
  10. 100  LOCATE 3,5:PRINT SPACE$(50):LOCATE 3,5:INPUT"Purge security levels less than: ";MS%
  11. 110  LOCATE 3,5:INPUT"Do you wish to purge by time since last call Y/N ";A$
  12. 120  A$=LEFT$(A$,1):IF (A$="N") OR (A$="n") THEN 140 ELSE TP%=1
  13. 130  LOCATE 3,5:PRINT SPACE$(55):LOCATE 3,5:INPUT"Purge with months since last call more than: ";MD%
  14. 140  LOCATE 3,5:PRINT SPACE$(55):LOCATE 3,5:INPUT"Do you wish to be prompted for each purge Y/N ";A$
  15. 150  A$=LEFT$(A$,1):IF (A$="N") OR (A$="n") THEN PR%=0 ELSE PR%=1
  16. 160  LOCATE 3,5:PRINT SPACE$(55):TD%=VAL(LEFT$(DATE$,2))
  17. 170  OPEN "R",1,UDRV$+":USERS",128
  18. 180  FIELD 1,31 AS UN$,15 AS UPW$,2 AS US$,14 AS UOP$,24 AS UC$,19 AS UM$,14 AS UD$,3 AS ULD$,2 AS UUL$,2 AS UDL$,2 AS UT$
  19. 190  OPEN "R",2,UDRV$+":USERS.NEW",128
  20. 200  FIELD 2,31 AS NN$,15 AS NPW$,2 AS NS$,14 AS NOP$,24 AS NC$,19 AS NM$,14 AS ND$,3 AS NLD$,2 AS NUL$,2 AS NDL$,2 AS NT$
  21. 210  OPEN "R",3,MDRV$+":MESSAGES",128
  22. 220  FIELD 3,128 AS RR$:NR%=1:GET 3,1
  23. 230  LREC%=(VAL(MID$(RR$,57,5)))-1:EF%=VAL(MID$(RR$,62,5))
  24. 240  FOR I%=1 TO LREC%:GET 1,I%
  25. 250  IF (ASC(UN$)=0) OR (LEFT$(UN$,2)="  ") THEN 440
  26. 260  SL%=CVI(US$):LD%=VAL(LEFT$(UD$,2))
  27. 270  ET%=TD%-LD%:IF ET%<0 THEN ET%=ET%+12
  28. 280  IF (SP%=1) AND (SL%<MS%) THEN 440
  29. 290  IF (TP%=1) AND (ET%>MD%) THEN 440
  30. 300  LOCATE 3,5:PRINT"Copying:  "+UN$
  31. 310  LSET NN$=UN$:LSET NPW$=UPW$:LSET NS$=US$:LSET NOP$=UOP$:LSET NC$=UC$
  32. 320  LSET NM$=UM$:LSET ND$=UD$:LSET NLD$=ULD$:LSET NUL$=UUL$:LSET NDL$=UDL$
  33. 330  LSET NT$=UT$
  34. 340  PUT 2,NR%:NR%=NR%+1
  35. 350  NEXT I%:NLREC%=NR%-1:LOCATE 22,5:PRINT SPACE$(65):FOR I%=NLREC% TO EF%
  36. 360  LSET NN$=SPACE$(31):LSET NPW$=SPACE$(15):LSET NS$=SPACE$(2)
  37. 370  LSET NOP$=SPACE$(14):LSET NC$=SPACE$(24):LSET NM$=SPACE$(19)
  38. 380  LSET ND$=SPACE$(14):LSET NLD$=SPACE$(3):LSET NUL$=SPACE$(2)
  39. 390  LSET NDL$=SPACE$(2):LSET NT$=SPACE$(2)
  40. 400  PUT 2,I%:LOCATE 22,5:PRINT"Record ";I%;" preformatted"
  41. 410  NEXT I%:CLOSE 1,2:MID$(RR$,57,5)=SPACE$(5):MID$(RR$,57,5)=STR$(NR%)
  42. 420  PUT 3,1:CLOSE:NAME UDRV$+":USERS" AS UDRV$+":USERS.ORG"
  43. 430  NAME UDRV$+":USERS.NEW" AS UDRV$+":USERS":CLS:END
  44. 440  IF PR%<>1 THEN GOSUB 490:GOTO 350
  45. 450  LOCATE 7,5:PRINT"Should I purge "+UN$+"  ";SL%;"  Y/N ";
  46. 460  INPUT A$:A$=LEFT$(A$,1):LOCATE 7,5:PRINT SPACE$(65)
  47. 470  IF A$="N" OR A$="n" THEN 300 ELSE GOSUB 490:GOTO 350
  48. 480  BEEP:CLOSE:STOP
  49. 490  LOCATE 22,5:PURG%=PURG%+1:PRINT"Records purged: ";PURG%:RETURN
  50. 500  IF ERR=58 AND ERL=420 THEN KILL UDRV$+":USERS.ORG":RESUME
  51. 510  BEEP:CLOSE:PRINT"Error ";ERR;" has occurred in line ";ERL:END
  52.